home *** CD-ROM | disk | FTP | other *** search
/ POINT Software Programming / PPROG1.ISO / pascal / swag / graphics.swg / 0115_Vga 256 Color PCX.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  1994-08-24  |  2.7 KB  |  89 lines
  1. {
  2.  CF> I am working with VGA 320x200x256.  Can anyone please help
  3.  CF> me with a good line routine and the PCX format?  I have
  4.  CF> tryed both and things go bad.. If you have code laying
  5.  CF> around it would help me a lot...  Thanks
  6.  
  7. }
  8.  
  9. PROCEDURE load_pcx(dx, dy : WORD; name : STRING);
  10. VAR q                          : FILE;        { Quellendatei-Handle         }
  11.     b                          : ARRAY[0..2047] OF BYTE;  { Puffer          }
  12.     anz, pos, c, w, h, e, pack : WORD;        { diverse benötigte Variablen }
  13.     x, y                       : WORD;        { für die PCX-Laderoutine     }
  14.  
  15. LABEL ende_background;                        { Sprungmarken definieren     }
  16.  
  17. BEGIN
  18.   x := dx; y := dy;                           { Nullpunkt festsetzen        }
  19.  
  20.   ASSIGN(q, name); {$I-} RESET(q, 1); {$I+}   { Quellendatei öffnen         }
  21.   IF IORESULT <> 0 THEN                       { Fehler beim Öffnen?         }
  22.     GOTO ende_background;                     { Ja: zum Ende springen       }
  23.  
  24.   BLOCKREAD(q, b, 128, anz);                  { Header einlesen             }
  25.  
  26.   IF (b[0] <> 10) OR (b[3] <> 8) THEN         { wirklich ein PCX-File?      }
  27.   BEGIN
  28.     CLOSE(q);                                 { Nein: Datei schließen und   }
  29.     GOTO ende_background;                     {       zum Ende springen     }
  30.   END;
  31.  
  32.   w := SUCC((b[9] - b[5]) SHL 8 + b[8] - b[4]);  { Breite auslesen          }
  33.   h := SUCC((b[11] - b[7]) SHL 8 + b[10] - b[6]);  { Höhe auslesen          }
  34.  
  35.   pack := 0; c := 0; e := y + h;
  36.   REPEAT
  37.     BLOCKREAD(q, b, 2048, anz);
  38.  
  39.     pos := 0;
  40.     WHILE (pos < anz) AND (y < e) DO
  41.     BEGIN
  42.       IF pack <> 0 THEN
  43.       BEGIN
  44.         FOR c := c TO c + pack DO
  45.           MEM[SEGA000:y*320+(x+c)] := b[pos];
  46.         pack := 0;
  47.       END
  48.       ELSE
  49.         IF (b[pos] AND $C0) = $C0 THEN
  50.           pack := b[pos] AND $3F
  51.         ELSE
  52.         BEGIN
  53.           MEM[SEGA000:y*320+(x+c)] := b[pos];
  54.           INC(c);
  55.         END;
  56.  
  57.       INC(pos);
  58.       IF c = w THEN                           { letzte Spalte erreicht?     }
  59.       BEGIN
  60.         c := 0;                               { Ja: Spalte auf 0 setzen und }
  61.         INC(y);                               {     in die nächste Zeile    }
  62.       END;
  63.     END;
  64.   UNTIL (anz = 0) OR (y = e);
  65.  
  66.   SEEK(q, FILESIZE(q) - 3 SHL 8 - 1);
  67.   BLOCKREAD(q, b, 3 SHL 8 + 1);
  68.  
  69.   IF b[0] = 12 THEN
  70.     FOR x := 1 TO 3 SHL 8 + 1 DO
  71.       b[x] := b[x] SHR 2;
  72.  
  73.   PORT[$3C8] := 0;
  74.  
  75.   FOR x := 0 TO 255 DO
  76.   BEGIN
  77.     PORT[$3C9] := b[x*3+1];
  78.     PORT[$3C9] := b[x*3+2];
  79.     PORT[$3C9] := b[x*3+3];
  80.   END;
  81.  
  82.   CLOSE(q);
  83.  
  84. ende_background:
  85. END;
  86.  
  87. BEGIN
  88.     Load_Pcx(1,1,'c:\lpexface.pcx');
  89. END.